home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / KeplerPorts.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-11-22  |  16.7 KB  |  396 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. MODULE KeplerPorts; (* J. Templ, 30.10.90/07.06.94 *)
  3.     (* Ports provide device independent drawing operations clipped on the port's borders.
  4.         All drawing and mouse coordinates are relative to the origin x0, y0, which is relative to the
  5.         top left corner of the port. Capital letter coordinates always denote screen coordinates.
  6.     IMPORT
  7.         Display, Display1, Fonts, Printer, TextPrinter, Sys, SYSTEM;
  8.     CONST
  9.         Ceres = FALSE; (*conditional compilation*)
  10.     TYPE
  11.         Port* = POINTER TO PortDesc;
  12.         PortDesc* = RECORD (Display.FrameDesc)
  13.             x0*, y0*, scale*: INTEGER;
  14.             ext*: Port;
  15.         END ;
  16.         DisplayPort* = POINTER TO DisplayPortDesc;
  17.         DisplayPortDesc* = RECORD (PortDesc) END ;
  18.         PrinterPort* = POINTER TO PrinterPortDesc;
  19.         PrinterPortDesc* = RECORD (PortDesc) END ;
  20.         BalloonPort* = POINTER TO BalloonPortDesc;
  21.         BalloonPortDesc* = RECORD (PortDesc) END ;
  22.         PolyHandle = LONGINT;
  23.         OpenPoly: PROCEDURE (): PolyHandle;
  24.         ClosePoly: PROCEDURE ();
  25.         PaintPoly: PROCEDURE (ph: PolyHandle);
  26. (* ----------------- abstract port methods ------------------ *)
  27.     PROCEDURE (P: Port) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  28.     END FillRect;
  29.     PROCEDURE (P: Port) DrawString*(x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  30.     END DrawString;
  31. (* ----------------- concrete port methods ------------------ *)
  32.     PROCEDURE (P: Port) CX*(x: INTEGER): INTEGER;
  33.     BEGIN RETURN P.X + (P.x0 + x) DIV P.scale
  34.     END CX;
  35.     PROCEDURE (P: Port) CY*(y: INTEGER): INTEGER;
  36.     BEGIN RETURN P.Y + P.H + (P.y0 + y) DIV P.scale
  37.     END CY;
  38.     PROCEDURE (P: Port) Cx*(X: INTEGER): INTEGER;
  39.     BEGIN RETURN (X - P.X) * P.scale - P.x0
  40.     END Cx;
  41.     PROCEDURE (P: Port) Cy*(Y: INTEGER): INTEGER;
  42.     BEGIN RETURN (Y - P.Y - P.H) * P.scale - P.y0
  43.     END Cy;
  44.     PROCEDURE (P: Port) DrawLine*(x1, y1, x2, y2, col, mode: INTEGER);
  45.         VAR x, y, dx, dy, d, inc, Xmin, Xmax, Ymin, Ymax: INTEGER;
  46.     BEGIN
  47.         x1 := P.CX(x1); y1 := P.CY(y1); x2 := P.CX(x2); y2 := P.CY(y2);
  48.         IF x1 < x2 THEN Xmin := x1; Xmax := x2 ELSE Xmin := x2; Xmax := x1 END;
  49.         IF y1 < y2 THEN Ymin := y1; Ymax := y2 ELSE Ymin := y2; Ymax := y1 END;
  50.         IF (y2-y1) < (x1-x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  51.         dx := 2*(x2-x1);
  52.         dy := 2*(y2-y1);
  53.         x := x1; y := y1; inc := 1;
  54.         IF dy > dx THEN d := dy DIV 2;
  55.             IF dx < 0 THEN inc := -1; dx := -dx END;
  56.             WHILE y <= y2 DO
  57.                 P.FillRect(P.Cx(x), P.Cy(y), P.scale, P.scale, col, 5, mode);
  58.                 INC(y); DEC(d, dx);
  59.                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  60.             END
  61.         ELSE d := dx DIV 2;
  62.             IF dy < 0 THEN inc := -1; dy := -dy END;
  63.             WHILE x <= x2 DO
  64.                 P.FillRect(P.Cx(x), P.Cy(y), P.scale, P.scale, col, 5, mode);
  65.                 INC(x); DEC(d, dy);
  66.                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  67.             END
  68.         END
  69.     END DrawLine;
  70.     PROCEDURE (P: Port) DrawRect*(x, y, w, h, col, mode: INTEGER);
  71.     BEGIN
  72.         IF P.scale = 1 THEN DEC(x); DEC(y);
  73.             P.FillRect(x,  y, w+3,  3, col, 5, mode);
  74.             P.FillRect(x+w,  y, 3,  h+3, col, 5, mode);
  75.             P.FillRect(x,  y+h, w+3,  3, col, 5, mode);
  76.             P.FillRect(x,  y, 3,  h+3, col, 5, mode)
  77.         ELSE
  78.             P.FillRect(x,  y, w,  P.scale, col, 5, mode);
  79.             P.FillRect(x+w-P.scale,  y, P.scale,  h, col, 5, mode);
  80.             P.FillRect(x,  y+h-P.scale, w,  P.scale, col, 5, mode);
  81.             P.FillRect(x,  y, P.scale,  h, col, 5, mode)
  82.         END
  83.     END DrawRect;
  84.     PROCEDURE HairEllipse (P: Port; X, Y, A, B, col, mode: INTEGER); (* due to B. Stamm *)
  85.         VAR x, y: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT;
  86.         PROCEDURE Dot4(x1, x2, y1, y2, col, mode: INTEGER);
  87.         BEGIN
  88.             P.FillRect(x1, y1, P.scale, P.scale, col, 5, mode);
  89.             P.FillRect(x1, y2, P.scale, P.scale, col, 5, mode);
  90.             P.FillRect(x2, y1, P.scale, P.scale, col, 5, mode);
  91.             P.FillRect(x2, y2, P.scale, P.scale, col, 5, mode);
  92.         END Dot4;
  93.     BEGIN
  94.         IF A = B THEN (* circle *)
  95.             DEC(A);
  96.             x := A; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*A;
  97.             WHILE x > y DO
  98.                 Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode);
  99.                 Dot4(P.Cx(X-y-1), P.Cx(X+y), P.Cy(Y-x-1), P.Cy(Y+x), col, mode);
  100.                 INC(d, dy); INC(dy, 8); INC(y);
  101.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  102.             END;
  103.             IF x = y THEN Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode) END
  104.         ELSIF (A > 0) & (B > 0) THEN (* ellipse *)
  105.             DEC(A); DEC(B);
  106.             a := A; a2 := a*a; a8 := 8*a2; b := B; b2 := b*b; b8 := 8*b2;
  107.             x := A; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a);
  108.             WHILE y2 < x2 DO
  109.                 Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode);
  110.                 INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  111.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2) END
  112.             END;
  113.             INC(d, 4*(x2+y2)-b2+a2);
  114.             WHILE x >= 0 DO
  115.                 Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode);
  116.                 DEC(d, dx); DEC(dx, b8); DEC(x);
  117.                 IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y) END
  118.             END
  119.         END
  120.     END HairEllipse;
  121.     PROCEDURE (P: Port) DrawEllipse*(x, y, a, b, col, mode: INTEGER);
  122.     BEGIN HairEllipse(P, P.CX(x), P.CY(y), a DIV P.scale, b DIV P.scale, col, mode)
  123.     END DrawEllipse;
  124.     PROCEDURE (P: Port) DrawCircle*(x, y, r, col, mode: INTEGER);
  125.     BEGIN HairEllipse(P, P.CX(x), P.CY(y), r DIV P.scale, r DIV P.scale, col, mode)
  126.     END DrawCircle;
  127.     PROCEDURE Line2(P: Port; col, pat, mode, x1, x2, y1, y2: INTEGER);
  128.     BEGIN
  129.         x1 := P.Cx(x1); x2 := P.Cx(x2); y1 := P.Cy(y1); y2 := P.Cy(y2);
  130.         P.FillRect(x1, y1, x2-x1, P.scale, col, pat, mode);
  131.         P.FillRect(x1, y2, x2-x1, P.scale, col, pat, mode)
  132.     END Line2;
  133.     PROCEDURE (P: Port) FillCircle* (x, y, r, col, pat, mode: INTEGER);
  134.         VAR x1, y1, d, dx, dy: INTEGER;
  135.     BEGIN x := P.CX(x); y := P.CY(y); r := r DIV P.scale;
  136.         IF (P.X < x + r) & (x - r < P.X + P.W) & (P.Y < y + r) & (y - r < P.Y + P.H) THEN
  137.             x1 := r - 1; y1 := 0; dx := (x1-1)*8; dy := y1*8 + 4; d := 3 - r*4;
  138.             WHILE x1 > y1 DO
  139.                 Line2(P, col, pat, mode, x-x1-1, x+x1, y-y1-1, y+y1);
  140.                 IF d+dy >= 0 THEN Line2(P, col, pat, mode, x-y1-1, x+y1, y-x1-1, y+x1) END ;
  141.                 INC(d, dy); INC(dy, 8); INC(y1);
  142.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x1) END
  143.             END;
  144.             IF x1 = y1 THEN Line2(P, col, pat, mode, x-x1-1, x+x1, y-y1-1, y+y1) END
  145.         END
  146.     END FillCircle;
  147.     PROCEDURE (P: Port) FillQuad* (x1, y1, x2, y2, x3, y3, x4, y4, col, pat, mode: INTEGER);    (* by B. Stamm *)
  148.       TYPE  LineParms = RECORD x,y,d,dx,dy,inx,iny,drawX,drawY: INTEGER END;
  149.       VAR x,y,RHS2,RHS3: INTEGER; left,right: LineParms;
  150.       PROCEDURE InitLineParms(x1,y1,x2,y2: INTEGER; VAR p: LineParms);
  151.       BEGIN
  152.         p.x := x1; p.dx := x2-x1; IF p.dx > 0 THEN p.inx := 1 ELSIF p.dx < 0 THEN p.inx := -1; p.dx := -p.dx ELSE p.inx := 0 END;
  153.         p.y := y1; p.dy := y2-y1; IF p.dy > 0 THEN p.iny := 1 ELSIF p.dy < 0 THEN p.iny := -1; p.dy := -p.dy ELSE p.iny := 0 END;
  154.         p.d := p.dy - p.dx; p.dx := 2*p.dx; p.dy := 2*p.dy;
  155.       END InitLineParms;
  156.       
  157.       PROCEDURE LineStep(VAR p: LineParms);
  158.         (* H = (d(x,y) := (2*x - 2*x1 + 1)*dy - (2*y - 2*y1 + 1)*dx < 0) *)
  159.       BEGIN
  160.         WHILE p.d < 0 DO INC(p.x,p.inx); INC(p.d,p.dy) END;
  161.         p.drawX := p.x; p.drawY := p.iny DIV 2 + p.y;
  162.         DEC(p.d,p.dx); INC(p.y,p.iny);
  163.       END LineStep;
  164.     PROCEDURE Max4(a,b,c,d: LONGINT): LONGINT;
  165.         VAR m: LONGINT;
  166.     BEGIN m := a;
  167.         IF b > m THEN m := b END ;
  168.         IF c > m THEN m := c END ;
  169.         IF d > m THEN m := d END ;
  170.         RETURN m
  171.     END Max4;
  172.     PROCEDURE Min4(a,b,c,d: LONGINT): LONGINT;
  173.         VAR m: LONGINT;
  174.     BEGIN m := a;
  175.         IF b < m THEN m := b END ;
  176.         IF c < m THEN m := c END ;
  177.         IF d < m THEN m := d END ;
  178.         RETURN m
  179.     END Min4;
  180.   BEGIN (* Quadrangle *)
  181.     x1 := P.CX(x1); x2 := P.CX(x2); x3 := P.CX(x3); x4 := P.CX(x4);
  182.     y1 := P.CY(y1); y2 := P.CY(y2); y3 := P.CY(y3); y4 := P.CY(y4);
  183.     IF (Max4(x1, x2, x3, x4) >= P.X) & (Min4(x1, x2, x3, x4) <= P.X + P.W) &
  184.         (Max4(y1, y2, y3, y4) >= P.Y) & (Min4(y1, y2, y3, y4) <= P.Y + P.H) THEN
  185.       IF (y1>y2) OR (y1=y2) & (x1>x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  186.       IF (y2>y3) OR (y2=y3) & (x2>x3) THEN x := x2; x2 := x3; x3 := x; y := y2; y2 := y3; y3 := y END;
  187.       IF (y3>y4) OR (y3=y4) & (x3>x4) THEN x := x3; x3 := x4; x4 := x; y := y3; y3 := y4; y4 := y END;
  188.       IF (y1>y2) OR (y1=y2) & (x1>x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  189.       IF (y2>y3) OR (y2=y3) & (x2>x3) THEN x := x2; x2 := x3; x3 := x; y := y2; y2 := y3; y3 := y END;
  190.       IF (y1>y2) OR (y1=y2) & (x1>x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  191.       IF LONG(x2-x1)*LONG(y4-y1) > LONG(y2-y1)*LONG(x4-x1) THEN RHS2 := 2 ELSE RHS2 := 0 END;
  192.       IF LONG(x3-x1)*LONG(y4-y1) > LONG(y3-y1)*LONG(x4-x1) THEN RHS3 := 1 ELSE RHS3 := 0 END;
  193.       CASE RHS2 + RHS3 OF
  194.       | 0: InitLineParms(x1,y1,x2,y2,left); InitLineParms(x1,y1,x4,y4,right);
  195.       | 1: InitLineParms(x1,y1,x2,y2,left); InitLineParms(x1,y1,x3,y3,right);
  196.       | 2: InitLineParms(x1,y1,x3,y3,left); InitLineParms(x1,y1,x2,y2,right);
  197.       | 3: InitLineParms(x1,y1,x4,y4,left); InitLineParms(x1,y1,x2,y2,right);
  198.       END;
  199.       WHILE left.y # y2 DO
  200.         LineStep(left); LineStep(right);
  201.         P.FillRect(P.Cx(left.drawX),P.Cy(left.drawY),P.Cx(right.drawX)-P.Cx(left.drawX),P.scale,col,pat,mode)
  202.       END;
  203.       CASE RHS2 + RHS3 OF
  204.       | 0: InitLineParms(x2,y2,x3,y3,left);
  205.       | 1: InitLineParms(x2,y2,x4,y4,left);
  206.       | 2: InitLineParms(x2,y2,x4,y4,right);
  207.       | 3: InitLineParms(x2,y2,x3,y3,right);
  208.       END;
  209.       WHILE left.y # y3 DO
  210.         LineStep(left); LineStep(right);
  211.         P.FillRect(P.Cx(left.drawX),P.Cy(left.drawY),P.Cx(right.drawX)-P.Cx(left.drawX),P.scale,col,pat,mode)
  212.       END;
  213.       CASE RHS2 + RHS3 OF
  214.       | 0,2: InitLineParms(x3,y3,x4,y4,left);
  215.       | 1,3: InitLineParms(x3,y3,x4,y4,right);
  216.       END;
  217.       WHILE left.y # y4 DO
  218.         LineStep(left); LineStep(right);
  219.         P.FillRect(P.Cx(left.drawX),P.Cy(left.drawY),P.Cx(right.drawX)-P.Cx(left.drawX),P.scale,col,pat,mode)
  220.       END
  221.     END
  222.   END FillQuad;
  223.     PROCEDURE (P: PrinterPort) FillQuad* (x1, y1, x2, y2, x3, y3, x4, y4, col, pat, mode: INTEGER);
  224.         VAR ph: PolyHandle;
  225.     BEGIN
  226.         x1 := SHORT((P.CX(x1)*300+150) DIV 300);
  227.         y1 := SHORT(((Printer.PageHeight-P.CY(y1))*300+150) DIV 300);
  228.         x2 := SHORT((P.CX(x2)*300+150) DIV 300);
  229.         y2 := SHORT(((Printer.PageHeight-P.CY(y2))*300+150) DIV 300);
  230.         x3 := SHORT((P.CX(x3)*300+150) DIV 300);
  231.         y3 := SHORT(((Printer.PageHeight-P.CY(y3))*300+150) DIV 300);
  232.         x4 := SHORT((P.CX(x4)*300+150) DIV 300);
  233.         y4 := SHORT(((Printer.PageHeight-P.CY(y4))*300+150) DIV 300);
  234.         Sys.MoveTo((x1), (y1));
  235.         ph := OpenPoly();
  236.         Sys.LineTo((x2), (y2));
  237.         Sys.LineTo((x3), (y3));
  238.         Sys.LineTo((x4), (y4));
  239.         ClosePoly();
  240.         PaintPoly(ph)
  241.     END FillQuad;
  242. (* ----------------- display drawing methods ------------------ *)
  243.     PROCEDURE (P: DisplayPort) DrawLine*(x1, y1, x2, y2, col, mode: INTEGER);
  244.     BEGIN Display1.Line(P, col, P.CX(x1), P.CY(y1), P.CX(x2), P.CY(y2), mode)
  245.     END DrawLine;
  246.     PROCEDURE (P: DisplayPort) DrawCircle*(x, y, r, col, mode: INTEGER);
  247.     BEGIN Display1.Circle(P, col, P.CX(x), P.CY(y), r DIV P.scale, mode)
  248.     END DrawCircle;
  249.     PROCEDURE (P: DisplayPort) DrawEllipse*(x, y, a, b, col, mode: INTEGER);
  250.     BEGIN Display1.Ellipse(P, col, P.CX(x), P.CY(y), a DIV P.scale, b DIV P.scale, mode);
  251.     END DrawEllipse;
  252.     PROCEDURE Intersect(F: Port; VAR X, Y, W, H: INTEGER): BOOLEAN;
  253.         VAR t: INTEGER;
  254.     BEGIN
  255.         t := X+W;
  256.         IF F.X > X THEN X := F.X END;
  257.         IF F.X+F.W < t THEN W := F.X+F.W-X ELSE W := t-X END;
  258.         IF W <= 0 THEN RETURN FALSE END;
  259.         t := Y+H;
  260.         IF F.Y > Y THEN Y := F.Y END;
  261.         IF F.Y+F.H < t THEN H := F.Y+F.H-Y ELSE H := t-Y END;
  262.         RETURN H > 0
  263.     END Intersect;
  264.     PROCEDURE (P: DisplayPort) DrawString*(x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  265.         VAR ch: CHAR; pat: LONGINT; X, i, dx, chx, chy, chw, chh, Y, oldX, oldY: INTEGER; fno: SHORTINT;
  266.     BEGIN fno := TextPrinter.FontNo(font);
  267.         X := P.CX(x); y := P.CY(y); ch := s[0]; i := 0;
  268.         WHILE ch # 0X DO
  269.             Display.GetChar(font.raster, ch, dx, chx, chy, chw, chh, pat);
  270.             IF Ceres THEN 
  271.                 X := X + chx; Y := y + chy;
  272.                 IF (X >= P.X) & (X+chw <= P.X + P.W) & (Y >= P.Y) & (Y+chh <= P.Y + P.H) THEN
  273.                     Display.CopyPattern(col, pat, X, Y, mode)
  274.                 ELSE
  275.                     oldX := X; oldY := Y;
  276.                     IF Intersect(P, X, Y, chw, chh) THEN
  277.                         Display.CopyBlock(X, Y, chw, chh, X - oldX, Y - oldY - 200, Display.replace);
  278.                         Display.CopyPattern(col, pat, 0, -200, mode);
  279.                         Display.CopyBlock(X - oldX, Y - oldY - 200, chw, chh, X, Y, Display.replace)
  280.                     END
  281.                 END
  282.             ELSE
  283.                 Display.CopyPatternC(P, col, pat, X+chx, y+chy, mode)
  284.             END ;
  285.             INC(x, SHORT(TextPrinter.DX(fno, ch) DIV 3048));
  286.             X := P.CX(x + P.scale DIV 2); INC(i); ch := s[i]
  287.         END
  288.     END DrawString;
  289.     PROCEDURE (P: DisplayPort) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  290.         VAR xp, yp: INTEGER;
  291.     BEGIN
  292.         x := P.CX(x); y := P.CY(y); w := w DIV P.scale; h := h DIV P.scale;
  293.         xp := P.CX(0); yp := P.CY(0);
  294.         IF Ceres THEN
  295.             IF Intersect(P, x, y, w, h) THEN 
  296.                 Display.ReplPattern(col, Display1.ThisPattern(pat), x, y, w, h, mode)
  297.             END
  298.         ELSIF pat = 5 THEN (* solid fg *)
  299.             Display.ReplConstC(P, col, x, y, w, h, mode)
  300.         ELSE
  301.             Display.ReplPatternC(P, col, Display1.ThisPattern(pat), x, y, w, h, xp, yp, mode)
  302.         END
  303.     END FillRect;
  304. (* ----------------- printer drawing methods ------------------ *)
  305.     PROCEDURE (P: PrinterPort) DrawLine* (x1, y1, x2, y2, col, mode: INTEGER);
  306.     BEGIN
  307.         x1 := P.CX(x1); y1 := P.CY(y1);
  308.         x2 := P.CX(x2); y2 := P.CY(y2);
  309.         Printer.Line(x1, y1, x2, y2)
  310.     END DrawLine;
  311.     PROCEDURE (P: PrinterPort) DrawCircle* (x, y, r, col, mode: INTEGER);
  312.     BEGIN Printer.Circle(P.CX(x), P.CY(y), r)
  313.     END DrawCircle;
  314.     PROCEDURE (P: PrinterPort) DrawEllipse* (x, y, a, b, col, mode: INTEGER);
  315.     BEGIN Printer.Ellipse(P.CX(x), P.CY(y), a, b)
  316.     END DrawEllipse;
  317.     PROCEDURE (P: PrinterPort) DrawString* (x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  318.     BEGIN
  319.         Printer.String(P.CX(x), P.CY(y), s, font.name)
  320.     END DrawString;
  321.     PROCEDURE (P: PrinterPort) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  322.     BEGIN
  323.         IF pat = 5 THEN Printer.ReplConst(P.CX(x), P.CY(y), w, h)
  324.         ELSE Printer.ReplPattern(P.CX(x), P.CY(y), w, h, pat)
  325.         END
  326.     END FillRect;
  327. (* ----------------- methods for finding the bounding box------------------ *)
  328.     PROCEDURE MinMax(x, y: INTEGER; VAR min, max: INTEGER);
  329.     BEGIN IF x < y THEN min := x; max := y ELSE min := y; max := x END
  330.     END MinMax;
  331.     PROCEDURE BlowUp (P: Port; x, y, w, h: INTEGER);
  332.     BEGIN x := x + P.x0; y := y + P.y0;
  333.         IF x < P.X THEN P.W := P.W + P.X - x; P.X := x END ;
  334.         IF x + w > P.X + P.W THEN P.W := x + w - P.X END ;
  335.         IF y < P.Y THEN P.H := P.H + P.Y - y; P.Y := y END ;
  336.         IF y + h > P.Y + P.H THEN P.H := y + h - P.Y END
  337.     END BlowUp;
  338.     PROCEDURE (P: BalloonPort) DrawRect* (x, y, w, h, col, mode: INTEGER);
  339.     BEGIN P.DrawRect^(x, y, w, h, col, mode)  (*BlowUp(P, x, y, w, h)*)
  340.     END DrawRect;
  341.     PROCEDURE (P: BalloonPort) DrawLine* (x1, y1, x2, y2, col, mode: INTEGER);
  342.         VAR minx, miny, maxx, maxy: INTEGER;
  343.     BEGIN
  344.         MinMax(x1, x2, minx, maxx);
  345.         MinMax(y1, y2, miny, maxy);
  346.         BlowUp(P, minx, miny, maxx - minx, maxy - miny)
  347.     END DrawLine;
  348.     PROCEDURE (P: BalloonPort) DrawCircle* (x, y, r, col, mode: INTEGER);
  349.     BEGIN BlowUp(P, x - r - 4 , y - r - 4, 2 * r + 4, 2 * r + 4)
  350.     END DrawCircle;
  351.     PROCEDURE (P: BalloonPort) DrawEllipse* (x, y, a, b, col, mode: INTEGER);
  352.     BEGIN BlowUp(P, x - a - 4, y - b - 4, 2 * a + 4, 2 * b + 4)
  353.     END DrawEllipse;
  354.     PROCEDURE StringWidth*(VAR s: ARRAY OF CHAR; f: Fonts.Font): INTEGER;
  355.         VAR fno: SHORTINT; ch: CHAR; dx, w, i, sdx, sx, sy, sw, sh: INTEGER; p: LONGINT;
  356.     BEGIN
  357.         fno := TextPrinter.FontNo(f);
  358.         w := 0; i := 0; ch := s[0];
  359.         WHILE ch # 0X DO
  360.             dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048);
  361.             INC(w, dx); INC(i); ch := s[i]
  362.         END ;
  363.         IF i > 0 THEN Display.GetChar(f.raster, s[i-1], sdx, sx, sy, sw, sh, p);
  364.             sdx := sdx * 4;
  365.             IF sdx > dx THEN INC(w, sdx - dx) END
  366.         END ;
  367.         RETURN w
  368.     END StringWidth;
  369.     PROCEDURE (P: BalloonPort) DrawString* (x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  370.     BEGIN BlowUp(P, x, y+font.minY*4, StringWidth(s, font), font.height*4)
  371.     END DrawString;
  372.     PROCEDURE (P: BalloonPort) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  373.     BEGIN BlowUp(P, x, y, w, h)
  374.     END FillRect;
  375.     PROCEDURE (P: BalloonPort) FillCircle* (x, y, r, col, pat, mode: INTEGER);
  376.     BEGIN BlowUp(P, x - r - 4 , y - r - 4, 2 * r + 4, 2 * r + 4)
  377.     END FillCircle;
  378.     PROCEDURE (P: BalloonPort) FillQuad* (x1, y1, x2, y2, x3, y3, x4, y4, col, pat, mode: INTEGER);
  379.     BEGIN
  380.         MinMax(x1, x2, x1, x2); MinMax(x2, x3, x2, x3); MinMax(x3, x4, x3, x4);
  381.         MinMax(x2, x3, x2, x3); MinMax(x1, x2, x1, x2);
  382.         MinMax(y1, y2, y1, y2); MinMax(y2, y3, y2, y3); MinMax(y3, y4, y3, y4);
  383.         MinMax(y2, y3, y2, y3); MinMax(y1, y2, y1, y2);
  384.         BlowUp(P, x1, y1, x4 - x1, y4 - y1)
  385.     END FillQuad;
  386.     PROCEDURE InitBalloon*(P: BalloonPort);
  387.     BEGIN P.scale := 1;
  388.         P.X := 10000; P.Y := 10000;
  389.         P.W := -20000; P.H := -20000
  390.     END InitBalloon;
  391. BEGIN
  392.     Sys.Assign("OpenPoly",  SYSTEM.ADR (OpenPoly));
  393.     Sys.Assign("ClosePoly",  SYSTEM.ADR (ClosePoly));
  394.     Sys.Assign("PaintPoly",  SYSTEM.ADR (PaintPoly))
  395. END KeplerPorts.
  396.